00010	BEGIN "XRUN"
00020	DEFINE ⊂="COMMENT";
00030	
00040	⊂ This program runs another program, BXX, as a separate job and produces
00050	an XGP plot of formant data from the specified file. This program may
00060	be executed directly, in which case it requests info from the TTY, or it
00070	be called into being as a separate job and passed a number specifying
00080	the file to be used. In this second case this program automatically
00090	kills its job on completion;
00100	
00110	DEFINE ⊃="⊂";
00120	DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00130	  INTEGER I,J,K,L,M,X,Y,LX,LY,DX,DY,CHAN5,CHAN1,EOF,BRCHR,DOTS,SMOO,
00140	    PP,POINTP,FLAG,MUTE,NUM;
00145	INTEGER ARRAY X1,XX2,Y1,YY2[0:10];
00150	  STRING FILEP,FILEN,READ,MEMO; BOOLEAN ER;
00160	  INTEGER ARRAY SAVE[0:10];
00170	  INTEGER ARRAY LFILE[0:127];
00180	  INTEGER ARRAY NEW[0:511];
00190	  INTEGER ARRAY DPYBUF[0:4096];
00200	INTEGER A1,A2,A3;
00210	LABEL STARTP;
00220	INTEGER DATE,TIME,SCALE;
00230	DEFINE GETIME="BEGIN DATE←CALL(0,""DATE""); TIME←CALL(0,""TIMER"")%60; END;";
00240	PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG",
00250		"SEP","OCT","NOV","DEC";
00252	STRING ARRAY MONTHS[0:11];
00254	
00256	
00257	PROCEDURE MEDIAN;
00258	
00259	BEGIN
00260	
00261	IF (Y1[I]>YY2[I])∧(Y>YY2[I]) THEN BEGIN
00262	    IF Y1[I]>Y THEN YY2[I]←Y ELSE YY2[I]←Y1[I];END;
00263	
00264	IF (Y1[I]<YY2[I])∧(Y<YY2[I])  THEN BEGIN
00265	    IF Y1[I]<Y THEN YY2[I]←Y ELSE YY2[I]←Y1[I]; END;
00266	
00267	Y1[I]←YY2[I]; YY2[I]←Y; Y←Y1[I]; X1[I]←XX2[I]; XX2[I]←X; X←X1[I];
00268	END;
00270	
00280	INTERNAL STRING PROCEDURE DATIM;
00290	BEGIN
00300	INTEGER DAY,YR,HRS,MIN,SEC;
00310	DAY←(DATE MOD 31)+1;DATE←DATE%31;
00320	YR←1964+DATE%12; SEC←TIME MOD 60;
00330	TIME←TIME%60; MIN←TIME MOD 60; HRS←TIME%60;
00340	SETFORMAT(-2,0);
00350	RETURN(CVS(DAY)&"-"&MONTHS[DATE MOD 12]&
00360	   "-"&CVS(YR)&"   "&CVS(HRS)&CVS(MIN)&":"&CVS(SEC));
00370	END;
00380	
00390	INTERNAL STRING PROCEDURE WTIM;
00400	BEGIN
00410	DATE←SAVE[2] LAND '7777; TIME←LDB(POINT(11,SAVE[2],23))*60;
00420	RETURN(DATIM);
00430	END;
00440	
00450	INTERNAL STRING PROCEDURE DATIME;
00460	BEGIN
00470	GETIME;
00480	RETURN(DATIM);
00490	END;
00500	
00510	
00520	⊂ Allow 1140 units on a line corresponding to 76 charactters @15 units,
00530	   380 segments @ 3 and 48640 samples @ 3/128 unit, or 2.432 seconds;
00540	
00550	
00560	PROCEDURE XPLOT;
00570	BEGIN "XPLOT"
00580	REQUIRE "SXF.REL[SAI,NJM]" LIBRARY;
00590	REQUIRE "XM.REL[FEB,NJM]" LIBRARY;
00600	REQUIRE "SIO.REL[SAI,NJM]" LIBRARY;
00610	EXTERNAL FORTRAN PROCEDURE XSET;
00620	EXTERNAL FORTRAN PROCEDURE XRVEC;
00630	EXTERNAL FORTRAN PROCEDURE XVEC;
00640	EXTERNAL FORTRAN PROCEDURE XIVEC;
00650	EXTERNAL FORTRAN PROCEDURE XIRVEC;
00660	EXTERNAL FORTRAN PROCEDURE XLINE;
00670	EXTERNAL FORTRAN PROCEDURE VERTAX;
00680	EXTERNAL FORTRAN PROCEDURE SWT25;
00690	EXTERNAL FORTRAN PROCEDURE PTX1;
00700	EXTERNAL FORTRAN PROCEDURE XOUT;
00710	EXTERNAL FORTRAN PROCEDURE XFIN;
00712	INTERNAL STRING XSTR,XSTR1,XSTR2,XSTRH;
00714	INTEGER IX,IX2,IY,XREF,YREF,X2,Y2,HT,XSAVE,XCUT;
00716	INTEGER MIN,MAX,ERR;
00741	
00742	XSET;
00750	MIN←0;
00760	MAX←100;
00770	XREF←400;
00780	YREF←800;
00790	HT←400;	⊂ Allowing 2 inches for 100 DB;
00791	⊂ VERTAX(MIN,MAX,XREF,YREF,HT);
00792	
00793	MAX←3000;
00794	YREF←150;
00795	HT←600;	⊂ Allowing 3 inches for 3000 hertz;
00810	VERTAX(MIN,MAX,XREF,YREF,HT);
00820	XOUT(XREF-8);
00830	XSAVE←0;
00840	
00850	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,2,0,0,0,EOF);
00860	LOOKUP(CHAN5,FILEP,ERR);
00870	FILEINFO(SAVE);
00880	IF ERR THEN OUTSTR("FILE "&FILEP&"  NOT FOUND"&CRLF);
00890	ARRYIN(CHAN5,LFILE[0],'200);
00900	
00910	XSTR←""; FOR I←10 STEP 1 UNTIL 20 DO XSTR←XSTR&CVXSTR(LFILE[I]);
00920	IX←XREF; IY←YREF-100; SWT25(IX,IY);
00930	 READ←WTIM; SETFORMAT(1,0);
00940	
00950	XSTR←"The first "&CVS(NUM)&" formants in parameter file "
00960	     &FILEP&" (created "&READ&")";
00970	IX←XREF; IY←1450; SWT25(IX,IY);
00980	IF SMOO=0 THEN XSTR←"Mute level at "&CVS(MUTE)&". "&MEMO ELSE
00985	  XSTR←"Mute level at "&CVS(MUTE)&" with medial smoothing. "&MEMO;
00990	IX←XREF+100; IY←1420; SWT25(IX,IY);
01000	XSTR←"A.I. Laboratory, Stanford University.   "&DATIME;
01010	IX←XREF+200; IY←1390; SWT25(IX,IY);
01020	
01030	FOR I←21 STEP 1 UNTIL 127 DO BEGIN "PONY"
01040	  IF LFILE[I]=0 THEN DONE;
01050	  L←LFILE[I] LAND '777760000000;
01060	  J←LDB(POINT(14,LFILE[I],27))-1; K←LDB(POINT(8,LFILE[I],35))-1;
01070	
01080	  X←J*128%SCALE+K*64%SCALE-8; ⊂ X←(J+K%2)*128%32-8;
01090	  IF X<XSAVE+16 THEN X←XSAVE+16; XSAVE←X;
01100	  IX←XREF+X; IY←YREF-45; XSTR←(READ←CVSTR(L))[1 TO 1]; SWT25(IX,IY);
01110	  IF (XSTR←READ[2 TO 2])≠"" THEN BEGIN
01120	    IY←YREF-70; SWT25(IX,IY); END;
01130	
01140	  IX←XREF+J*128%SCALE; IX2←IX+K*128%SCALE;
01150	  XLINE(IX,YREF-20,IX,YREF);
01160	  XLINE(IX,YREF,IX2,YREF);
01170	  XLINE(IX,YREF-1,IX2,YREF-1);
01180	  XLINE(IX,YREF-2,IX2,YREF-2);
01190	  XLINE(IX2,YREF,IX2, YREF-20);
01200	
01210	  END "PONY";
01220	OUTSTR("Text,");
01225	
01230	FOR I←0 STEP 20000%SCALE UNTIL IX DO BEGIN "TIME"
01240	  XLINE(XREF+I,YREF,XREF+I,YREF+20);
01242	  IF (I≠0)∧(DOTS=0) THEN FOR J←100 STEP 100 UNTIL 600 DO BEGIN
01243	    XLINE(XREF+I-5,YREF+J,XREF+I+5,YREF+J);
01246	    XLINE(XREF+I,YREF+J-5,XREF+I,YREF+J+5);  END;
01250	  FOR K←1 STEP 1 UNTIL 9 DO BEGIN
01260	    IX←XREF+I+K*2000%SCALE; IF IX>IX2 THEN DONE "TIME";
01270	    XLINE(IX,YREF,IX,YREF+10);
01275	    IF DOTS=0 THEN FOR J←100 STEP 100 UNTIL 600 DO BEGIN
01276	      XLINE(IX-2,YREF+J,IX+2,YREF+J); XLINE(IX,YREF+J-2,IX,YREF+J+2); END;
01277	    END;
01280	  END "TIME";
01285	XOUT(XREF-2);
01290	
01300	XCUT←IX2+200;
01310	
01320	
01330	FOR I←0 STEP 1 UNTIL 10 DO BEGIN
01335	  SAVE[I]←0; X1[I]←0; XX2[I]←Y1[I]←YY2[I]←0;  END;
01337	
01340	WHILE EOF=0 DO BEGIN "XDATIN"
01345	  FOR I ←0 STEP 1 UNTIL 511 DO NEW[I]←0;
01350	  ARRYIN(CHAN5,NEW[0],512);
01355	  IF NEW[0]=0 THEN DONE;
01360	
01370	  FOR I←1 STEP 1 UNTIL NUM DO BEGIN "XPLO"
01380	    LY←SAVE[I]; LX←SAVE[0]; XIVEC(XREF+LX,YREF+LY);
01390	    FOR J←0 STEP 8 UNTIL 504 DO BEGIN
01400	      IF NEW[J]=0 THEN DONE;
01410	      X←(NEW[J] LSH -15)%SCALE;
01420	        ⊂ Allowing 32 samples per unit or 3.125 inches per second;
01430	        ⊂ This corresponds to 512 samples (32*16) per character;
01440	
01450	      POINTP←POINT(9,NEW[J+1],-1);
01460	      FOR K←1 STEP 1 UNTIL I DO IBP(POINTP);
01470	      Y← LDB(POINTP)*2000%256; ⊂ 5 inches for 5000 hertz;
01474	
01477	      IF SMOO=1 THEN MEDIAN;	⊂ Replaces Y and X by previous values with medial smoothing;
01480	
01500	      DX←X-LX; LX←X; DY←Y-LY; LY←Y;
01510	      IF (LDB(POINT(9,NEW[J+2],17)) < MUTE)∨(DX<3)
01520	        THEN XIRVEC(DX,DY) ELSE  XRVEC(DX,DY);
01530	      END;
01540	    SAVE[I]←LY;
01550	    END "XPLO";
01560	
01570	  FOR I←6 STEP 1 UNTIL 5 DO BEGIN "XPLO2"
01580	    LY←SAVE[I]; LX←SAVE[0]; XIVEC(XREF+LX,YREF+650+LY);
01590	    FOR J←0 STEP 8 UNTIL 504 DO BEGIN
01600	      IF NEW[J]=0 THEN DONE;
01610	      X←(NEW[J] LSH -15)%SCALE;
01620	        ⊂ Allowing 32 samples per unit or 3.125 inches per second;
01630	        ⊂ This corresponds to 512 samples (32*16) per character;
01640	
01650	      POINTP←POINT(9,NEW[J+1],-1);
01660	      FOR K←1 STEP 1 UNTIL I DO IBP(POINTP);
01670	      Y← LDB(POINTP)*4; ⊂ 2 inches for 100 DB;
01680	
01700	      DX←X-LX; LX←X; DY←Y-LY; LY←Y;
01720	      XRVEC(DX,DY);
01730	      END;
01740	    SAVE[I]←LY;
01750	    END "XPLO2";
01760	
02560	  XOUT(LX-20); OUTSTR(CVS(LX)&",");
02570	
02580	  IF X=0 THEN DONE "XDATIN";
02590	  SAVE[0]←LX;
02600	  END "XDATIN";
02610	CLOSE(CHAN5);
02620	XOUT(XCUT); OUTSTR(CVS(XCUT)&CRLF);
02630	IF XCUT<2200 THEN BEGIN XCUT←2200; XOUT(XCUT); END;
02640	
02650	XFIN;
02660	END "XPLOT";
02670	
     

00010	CHAN1←1; CHAN5←5;
00015	SCALE←20; DOTS←SMOO←0; MEMO←"";
00018	
00020	STDBRK(1);
00030	STARTP:
00040	MUTE←60; NUM←3;
00050	CLOSE(CHAN1); OPEN(CHAN1,"DSK",0,1,0,70,BRCHR,EOF);
00060	LOOKUP(CHAN1,"NUMBER.TMP",ER);
00070	IF ER THEN BEGIN
00075	OUTSTR("This program graphs formants on the XGP from a parameter file."&CRLF);
00080	OUTSTR("The following set-up commands (with CR) "
00090	  &"may be given:"&CRLF);
00100	OUTSTR("	M#	set MUTE level to # (default value 60)"&CRLF&
00105	"	R#	set scale reduction factor (default value 20)"&CRLF&
00107	"	D	delete scale points (default condition with points)"&CRLF&
00108	"	S	medial smooth (default condition with no smoothing)"&CRLF&
00109	"	C	typed comment to CR (60 char. max.) will appear on graph"&CRLF&
00110	"	N#	set number of formants (default value 3)."&CRLF);
00120	OUTSTR("A number (without letter) terminates condition-setting and specifies the file to use."
00130	      &CRLF&TB&"A CR only calls for file # 1."&CRLF&LF);
00140	SETFORMAT(1,0); FLAG←0; X←0;
00150	WHILE TRUE DO BEGIN "TYPE" OUTSTR("Type command  "); READ←INCHWL;
00160	IF READ[1 TO 1]="M" THEN BEGIN MUTE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00165	IF READ[1 TO 1]="R" THEN BEGIN SCALE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00166	IF READ[1 TO 1]="S" THEN BEGIN SMOO←1; CONTINUE "TYPE";END;
00167	IF READ[1 TO 1]="D" THEN BEGIN DOTS←1;CONTINUE "TYPE";END;
00168	IF READ[1 TO 1]="C" THEN BEGIN MEMO←READ[2 TO 61];CONTINUE "TYPE";END;
00170	IF READ[1 TO 1]="N" THEN BEGIN NUM←CVD(READ[2 TO 2]);CONTINUE "TYPE";END;
00180	DONE; END "TYPE";
00190	IF READ="" THEN PP←1 ELSE PP←CVD(READ);
00200	END ELSE BEGIN
00210	  PP←CVD(INPUT(CHAN1,1));
00215	  MEMO←INPUT(CHAN1,1);
00220	  CLOSE(CHAN1);
00230	  END;
00240	
00250	FILEP←"SEG"&CVS(PP)&".SYN[SYN,ALS]";
00260	
00270	XPLOT;
00280	PTOSTR(0,"RU BXX[FEB,NJM]"&CRLF);
00300	
00310	END "XRUN";